COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00009 ENDMK
C⊗;
ENTRY;
BEGIN "PPCODE"
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

REQUIRE "[][]" DELIMITERS;
REDEFINE MAKEOP(OPNUM,OPNAM,OPVAL)"[]" = [,"OPNAM"];
PRESET_WITH "not valid" INTOPS;
STRING ARRAY SPCODE[0:#ALINTOPS/2];

SIMPLE STRING PROCEDURE SCODE(INTEGER I);
	IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
		ELSE RETURN(SPCODE[0]);

RECURSIVE PROCEDURE PPRIN(INTEGER ARRAY RR; INTEGER SNUM,INDEXF; STRING INDENT);
BEGIN
	! program to print out pcode from number form to pcode form;
	INTEGER INDEX;
	PROCEDURE RPRINT;
	BEGIN "print real numbers"
		PRINT("	",RFVAL(RR[INDEX+1],
				RR[INDEX+2]));
		INDEX←INDEX+2;
	END;

	PROCEDURE OPRINT;
	"prints octal"	PRINT("	",CVOS(RR[INDEX←INDEX+1]));

	PROCEDURE RDPRINT(INTEGER OFFSET(-1));
	"prints relative decimal"
		BEGIN INTEGER I;
		! if offset not specified then take wrt to current position ;
		I←RR[INDEX←INDEX+1];
		PRINT("	.");
		IF I≥0 THEN PRINT("+");
		PRINT(I,"(D)");
		IF OFFSET<0 THEN PRINT("	{=",INDEX+RR[INDEX],"(D)}")
			ELSE PRINT("	{=",RR[INDEX]+OFFSET,"(D)}");
		END;

	PROCEDURE DPRINT;
	"prints decimal"
		PRINT("	",RR[INDEX←INDEX+1],"(D)");

	PROCEDURE NLPRINT;
	"prints newline"
		PRINT(CRLF,INDEX+1,":	",INDENT);

	PROCEDURE NPCODE;
	BEGIN	"prints new pcode"
		INTEGER I,J;
		NLPRINT;		! start new line;
		I←RR[INDEX←INDEX+1]/2;
		J←RR[INDEX] MOD 2;
		IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
			THEN PRINT(SPCODE[I])
			ELSE PRINT(RR[INDEX],"(D)");
		IF J=0 THEN
		CASE I OF
		BEGIN
		    [XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
			RDPRINT;
		    [XRJMP/2][XRPRINT/2][XRJMPC/2][XRFRCHK/2]
			RDPRINT;
		    [XPRNTC/2]
			BEGIN STRING S;
			S←TAB&DQUOTE&(RR[INDEX←INDEX+1] LSH -8)&DQUOTE;
			PRINT(S);
			END;
		    [XPRNTI/2]
			BEGIN STRING S; INTEGER CHAR,SS;
			DPRINT;
			I←INDEX;
			S←TAB&DQUOTE;
			DO BEGIN SS←RR[I←I+1];
				S←S&(SS LSH -8)&(CHAR←SS LAND '377);
			END UNTIL CHAR=0;
			INDEX←INDEX+RR[INDEX];
			S←S&DQUOTE;
			PRINT(S);
			END;
		    [XPUSHSCI/2]
			RPRINT;
		    [XMKVT/2][XMKRT/2]
			BEGIN RPRINT;RPRINT;RPRINT;END;
		    [XMKTR/2]
			BEGIN RPRINT;RPRINT;RPRINT; NLPRINT;
				RPRINT;RPRINT;RPRINT; END;
		    [XARRLD/2]
			BEGIN INTEGER I,J; RPTR(SYMBOL)SYM;
			I←RR[INDEX+1];
			OPRINT;DPRINT;
			ARRYDIM(I,SYM);
			IF SYM THEN
				BEGIN
				CASE RR[INDEX] OF
				BEGIN [#SC] J←1;
					[#VT] [#RT] J←3;
					[#TR] [#FR] J←6;
					[#EV] J←0
				END;
			FOR I←1 STEP 1 UNTIL ARRAYREC:#EL[SYMBOL:OBJECT[SYM]]*J
				DO BEGIN NLPRINT;RPRINT; END;
				END;
			END;
		    [XAFFIX/2]
			BEGIN
			OPRINT;	OPRINT;	OPRINT;
			IF RR[INDEX] LAND '2000 THEN OPRINT;
			END;
		    [XAGTVAL/2][XACHNGE/2][XARTVAL/2]
			BEGIN OPRINT; OPRINT; END;
		    [XRCASE/2]
			BEGIN
			INTEGER NCASES,I,J;
			DPRINT;	NCASES←ABS(RR[J←INDEX])+1;
			FOR I←1 STEP 1 UNTIL NCASES DO
				BEGIN NLPRINT; RDPRINT(J+1); END;
			END;
		    [XGTBLK/2]
			BEGIN
			DPRINT;PPRIN(RR,INDEX+1,INDEX+RR[INDEX],INDENT&"    ");
			INDEX←INDEX+RR[INDEX];
			NLPRINT; PRINT(RR[INDEX←INDEX+1],"(D)");
			END;
		    [XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
		    [XCOPY/2][XRETURN/2][XPROC/2][XREPLAC/2]
		    [XGATHER/2][XCMDSBL/2][XSTOP/2][XCHCMP/2]
		    [XPUSHOFFSET/2][XPAFFIX/2][XCMENBL/2][XTFRCST/2]
		    [XARRINI/2]
			OPRINT;
		    [XRCENTER/2][XRPMOVE/2][XRTADRIVE/2][XRTDDRIVE/2]
			BEGIN RDPRINT; OPRINT; END;
		    [XMVAR/2]
			DO OPRINT UNTIL RR[INDEX]=0;
		    [XAPUSHOFFSET/2]
			BEGIN OPRINT;OPRINT END;
		    [XGTINT/2][XGVALS/2][XCHNGS/2][XPUNFIX/2]
			INDEX←INDEX;
		    [XPSPROUT/2]
			BEGIN INTEGER I,N;
			    DPRINT;
			    N←RR[INDEX];
			    FOR I←1 STEP 1 UNTIL N DO
				BEGIN NLPRINT; RDPRINT;OPRINT; END;
			    NLPRINT; OPRINT;
			END;
		    ELSE INDEX←INDEX
		END;
		
	END;
	INDEX←SNUM-1;
	WHILE INDEX<INDEXF DO NPCODE;
END;

INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN	PPRIN(EXPR$:BODY[EE],SNUM,EXPR$:#BODY[EE],NULL);
	PRINT(CRLF,EXPR$:#BODY[EE]+1,":",CRLF);
END;

PROCEDURE PPPCODE;ppcode(null_record);
END;